home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / bigarr / bigarray.bas next >
BASIC Source File  |  1995-01-10  |  15KB  |  470 lines
  1. Option Explicit
  2.  
  3. Global Const MaxRows = 100
  4. Global Const MaxCols = 100
  5. Global Const MaxSheets = 10
  6. Global Const MaxValues = 30
  7.  
  8. Global DirectoryForApplication      As String
  9. Global SelectedLanguage             As String
  10. Global CurrentLanguage              As Integer
  11. Global AtLeastOneValidDrive         As Integer
  12. Global SelectedDrive                As String * 1
  13. Global DirectoryTest                As String
  14.  
  15. Global Rows                         As Long
  16. Global Cols                         As Long
  17. Global Sheets                       As Long
  18.  
  19. Type tagTypTest  'definition for type'd test
  20.    Int                              As Integer
  21.    Lng                              As Long
  22.    Snl                              As Single
  23.    Dbl                              As Double
  24.    Stg                              As String * 14
  25. End Type
  26.  
  27. Dim StrTest                         As String * 14
  28. Dim TypTest                         As tagTypTest
  29.  
  30. Dim DA(1 To 6)                      As tagDISKARRAY
  31.  
  32. Sub BigArrayInit ()
  33.  
  34.    Dim ErrCode       As Integer
  35.  
  36.    ' disable the form
  37.    cDisableFI frmBig1.Picture1
  38.  
  39.    ' make a directory on the selected drive for test,
  40.    ' don't take care of the returned error if the directory
  41.    ' already exist
  42.    ErrCode = cMakeDir(DirectoryTest)
  43.  
  44.    ' clear the list for initialization
  45.    frmBig1.List1.Clear
  46.  
  47.    ' initialize each type of variable, see InitBigInteger for explain
  48.    Call InitBigInteger
  49.    Call InitBigLong
  50.    Call InitBigSingle
  51.    Call InitBigDouble
  52.    Call InitBigString
  53.    Call InitBigTyped
  54.  
  55.    ' enable the form
  56.    cEnableFI frmBig1.Picture1
  57.  
  58. End Sub
  59.  
  60. Sub DeleteDemoFiles ()
  61.  
  62.    Dim i          As Integer
  63.    Dim ErrCode    As Integer
  64.  
  65.    ' close all arrays (in not already closed) and delete it
  66.    For i = 1 To 6
  67.       Call cDAClose(DA(i), True)
  68.    Next i
  69.  
  70.    ' remove the test directory
  71.    ErrCode = cKillDir(DirectoryTest)
  72.  
  73. End Sub
  74.  
  75. Sub DisplayMessage (Frm As Form, TextOrder As String, InsertText As String)
  76.  
  77.    ' display a multi-language message box, message are centered
  78.    ' and a timeout of 16 seconds is displayed.
  79.    Call cLngBoxMsg(CurrentLanguage, ReadText(Frm, TextOrder, InsertText), MB_MESSAGE_CENTER Or MB_TIMEOUT_16 Or MB_DISPLAY_TIMEOUT Or 32, "BIG DISK ARRAY")
  80.  
  81. End Sub
  82.  
  83. Sub InitBigDouble ()
  84.  
  85.    ' see explain in InitBigInteger
  86.  
  87.    Dim ErrCode    As Integer
  88.  
  89.    DA(4).nFilename = DirectoryTest + "\dadouble.tmp"
  90.    DA(4).nType = DA_DOUBLE
  91.    DA(4).nIsTyped = False
  92.    DA(4).nRows = Rows
  93.    DA(4).nCols = Cols
  94.    DA(4).nSheets = Sheets
  95.  
  96.    ErrCode = cDACreate(DA(4), True)
  97.  
  98.    If (ErrCode = DA_NO_ERROR) Then
  99.       frmBig1.List1.AddItem ReadText(frmBig1, "IS", "DOUBLE" & "~" & Trim$(DA(4).nFilename) & "~" & DA(4).rFileSize & "~" & DA(4).rTime)
  100.    Else
  101.       frmBig1.List1.AddItem ReadText(frmBig1, "IF", "DOUBLE" & "~" & ErrCode)
  102.    End If
  103.  
  104.    Call cDAClose(DA(4), False)
  105.  
  106.    frmBig1.List1.Refresh
  107.  
  108. End Sub
  109.  
  110. Sub InitBigInteger ()
  111.  
  112.    Dim ErrCode    As Integer
  113.  
  114.    ' name of the file to store the array
  115.    DA(1).nFilename = DirectoryTest + "\daint.tmp"
  116.    ' type of the array
  117.    DA(1).nType = DA_INTEGER
  118.    ' is the array, an array of type'd variable
  119.    DA(1).nIsTyped = False
  120.    ' maximum number of rows
  121.    DA(1).nRows = Rows
  122.    ' maximum number of cols
  123.    DA(1).nCols = Cols
  124.    ' maximum number of sheets
  125.    DA(1).nSheets = Sheets
  126.  
  127.    ' create the big array (full initialization) and use it
  128.    ErrCode = cDACreate(DA(1), True)
  129.  
  130.    ' check if an error has occured when initializing
  131.    If (ErrCode = DA_NO_ERROR) Then
  132.       ' no error, what's a chance, display a success message
  133.       ' + name of the file
  134.       ' + size of the file
  135.       ' + time for initialization
  136.       frmBig1.List1.AddItem ReadText(frmBig1, "IS", "INTEGER" & "~" & Trim$(DA(1).nFilename) & "~" & DA(1).rFileSize & "~" & DA(1).rTime)
  137.    Else
  138.       ' error, number of the error is displayed
  139.       frmBig1.List1.AddItem ReadText(frmBig1, "IF", "INTEGER" & "~" & ErrCode)
  140.    End If
  141.  
  142.    ' close the big array
  143.    Call cDAClose(DA(1), False)
  144.  
  145.    frmBig1.List1.Refresh
  146.  
  147. End Sub
  148.  
  149. Sub InitBigLong ()
  150.  
  151.    ' see explain in InitBigInteger
  152.  
  153.    Dim ErrCode    As Integer
  154.  
  155.    DA(2).nFilename = DirectoryTest + "\dalong.tmp"
  156.    DA(2).nType = DA_LONG
  157.    DA(2).nIsTyped = False
  158.    DA(2).nRows = Rows
  159.    DA(2).nCols = Cols
  160.    DA(2).nSheets = Sheets
  161.  
  162.    ErrCode = cDACreate(DA(2), True)
  163.  
  164.    If (ErrCode = DA_NO_ERROR) Then
  165.       frmBig1.List1.AddItem ReadText(frmBig1, "IS", "LONG" & "~" & Trim$(DA(2).nFilename) & "~" & DA(2).rFileSize & "~" & DA(2).rTime)
  166.    Else
  167.       frmBig1.List1.AddItem ReadText(frmBig1, "IF", "LONG" & "~" & ErrCode)
  168.    End If
  169.  
  170.    Call cDAClose(DA(2), False)
  171.  
  172.    frmBig1.List1.Refresh
  173.  
  174. End Sub
  175.  
  176. Sub InitBigSingle ()
  177.  
  178.    ' see explain in InitBigInteger
  179.  
  180.    Dim ErrCode    As Integer
  181.  
  182.    DA(3).nFilename = DirectoryTest + "\dasingle.tmp"
  183.    DA(3).nType = DA_SINGLE
  184.    DA(3).nIsTyped = False
  185.    DA(3).nRows = Rows
  186.    DA(3).nCols = Cols
  187.    DA(3).nSheets = Sheets
  188.  
  189.    ErrCode = cDACreate(DA(3), True)
  190.  
  191.    If (ErrCode = DA_NO_ERROR) Then
  192.       frmBig1.List1.AddItem ReadText(frmBig1, "IS", "SINGLE" & "~" & Trim$(DA(3).nFilename) & "~" & DA(3).rFileSize & "~" & DA(3).rTime)
  193.    Else
  194.       frmBig1.List1.AddItem ReadText(frmBig1, "IF", "SINGLE" & "~" & ErrCode)
  195.    End If
  196.  
  197.    Call cDAClose(DA(3), False)
  198.  
  199.    frmBig1.List1.Refresh
  200.  
  201. End Sub
  202.  
  203. Sub InitBigString ()
  204.  
  205.    ' see explain in InitBigInteger
  206.  
  207.    Dim ErrCode    As Integer
  208.  
  209.    DA(5).nFilename = DirectoryTest + "\dastring.tmp"
  210.    DA(5).nType = Len(StrTest)
  211.    DA(5).nIsTyped = False
  212.    DA(5).nRows = Rows
  213.    DA(5).nCols = Cols
  214.    DA(5).nSheets = Sheets
  215.  
  216.    ErrCode = cDACreate(DA(5), True)
  217.  
  218.    If (ErrCode = DA_NO_ERROR) Then
  219.       frmBig1.List1.AddItem ReadText(frmBig1, "IS", "STRING" & "~" & Trim$(DA(5).nFilename) & "~" & DA(5).rFileSize & "~" & DA(5).rTime)
  220.    Else
  221.       frmBig1.List1.AddItem ReadText(frmBig1, "IF", "STRING" & "~" & ErrCode)
  222.    End If
  223.  
  224.    Call cDAClose(DA(5), False)
  225.  
  226.    frmBig1.List1.Refresh
  227.  
  228. End Sub
  229.  
  230. Sub InitBigTyped ()
  231.  
  232.    ' see explain in InitBigInteger
  233.  
  234.    Dim ErrCode    As Integer
  235.  
  236.    DA(6).nFilename = DirectoryTest + "\datyped.tmp"
  237.    DA(6).nType = Len(TypTest)
  238.    DA(6).nIsTyped = True
  239.    DA(6).nRows = Rows
  240.    DA(6).nCols = Cols
  241.    DA(6).nSheets = Sheets
  242.  
  243.    ErrCode = cDACreate(DA(6), True)
  244.  
  245.    If (ErrCode = DA_NO_ERROR) Then
  246.       frmBig1.List1.AddItem ReadText(frmBig1, "IS", "TYPE'D" & "~" & Trim$(DA(6).nFilename) & "~" & DA(6).rFileSize & "~" & DA(6).rTime)
  247.    Else
  248.       frmBig1.List1.AddItem ReadText(frmBig1, "IF", "TYPE'D" & "~" & ErrCode)
  249.    End If
  250.  
  251.    Call cDAClose(DA(6), False)
  252.  
  253.    frmBig1.List1.Refresh
  254.  
  255. End Sub
  256.  
  257. Sub Loader ()
  258.  
  259.    DoEvents
  260.  
  261.    Dim i          As Integer
  262.    Dim d          As Integer
  263.    Dim ErrCode    As Integer
  264.    Dim SplitPath  As tagSPLITPATH
  265.  
  266.    ' change the language to the current language in the system menu of the current form
  267.    Call cLngSysMenu(CurrentLanguage, frmBigArray.hWnd)
  268.  
  269.    ' some initializations
  270.    CurrentLanguage = LNG_ENGLISH
  271.    DirectoryForApplication = cGetIn(cEXEnameActiveWindow(), ".", 1)
  272.    ' split the path of the application into four components
  273.    ErrCode = cSplitPath(DirectoryForApplication, SplitPath)
  274.    ' regenerate only the directory of the application
  275.    DirectoryForApplication = SplitPath.nDrive + SplitPath.nDir
  276.    ' set the default language
  277.    SelectedLanguage = ".TUK"
  278.    
  279.    ' display a message before starting search of valid drive
  280.    Call DisplayMessage(frmBigArray, "0", "")
  281.  
  282.    ' find all valid drives (C to Z) which can handle the demonstration
  283.    For i = 3 To 26
  284.  
  285.       ' get the type of the drive
  286.       d = cGetDriveType(Chr$(64 + i))
  287.  
  288.       ' test if the drive is valid
  289.       If ((d <> DRIVE_UNKNOW) And (d <> DRIVE_CDROM)) Then
  290.          ' drive is valid, now check the free disk space greater than 7 Mb
  291.          If (cGetDiskFree(Chr$(64 + i)) > 7000000) Then
  292.             frmBigArray.Combo1.AddItem Chr$(64 + i)
  293.          End If
  294.       End If
  295.  
  296.    Next i
  297.  
  298.    ' check if at least one drive is in